COMMENT ⊗   VALID 00021 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	 MacLisp portion of the E/MacLisp Interface.
C00008 00003	 Here are the interrupt handlers for user interrupts
C00014 00004	 αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
C00017 00005	(lap em:get-mail subr)
C00021 00006	(entry em:mail-type subr)
C00026 00007	(entry em:wait-mail subr)
C00027 00008	(entry em:mail-sfa subr)
C00028 00009	 TYI
C00030 00010	 TYO
C00031 00011	 FORCE OUTPUT
C00034 00012	(entry rcc subr)
C00036 00013	 This routine gets fresh mail to initialize the reader
C00038 00014	 This routine does a jobread into the right spot.
C00040 00015	wait-ok  
C00041 00016	(entry em:send-simple-message subr)
C00044 00017	(entry em:send-control-char subr)
C00046 00018	(entry em:initialize subr)
C00047 00019	send-ok
C00048 00020	(entry em:eval-protect subr)
C00049 00021	 Storage for Mail routines
C00051 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;; Starts with -em:jobnum- figured out from E.

(declare (mapex t)
         (setq defmacro-for-compiling ())
	 (special -em:jobnum- -em:e-commands- -em:sfa- -em:errorp-)
	 (fixnum -em:jobnum-))

(setq -em:e-commands- ())

(defun em:negotiate ()
;      (em:send-simple-message 'ok -em:jobnum-)
       t)
 
(defun em:toplevel ()
       (let ((em:sfa (sfa-create (function em:mail-sfa) 0 'mail-sfa)))
	    (setq msgfiles `(,em:sfa)
		  tyo em:sfa)
	    (do () ((em:negotiate)))
	    (do ((message-type (progn (em:wait-mail)
				      (prog2 () (em:get-mail)))
			       (progn (em:wait-mail)
				      (prog2 () (em:get-mail)))))
		(())
		(*catch 'em:toplevel
			(caseq message-type
		       (sexps
			(em:eval-file em:sfa))
		       (control-chars
			(em:eval-control-file em:sfa))
		       (no-op ())
		       (wrong-job (em:wrong-jobnum))
		       (unknown ()))))))
		       
(defun em:eval-file (sfa)
 (setq -em:sfa- sfa -em:errorp- ())
 (let ((eof (ncons ())))
      (do ((form (read sfa eof)
		 (read sfa eof))
	   (ans))
	  ((eq form eof) t)
	  (em:eval-protect)
	  (setq ans (eval form))
	  (em:eval-unprotect)
	  (print ans sfa)
	  (sfa-call sfa 'force-output ())
	  (cond (-em:errorp- (return ()))))))

(defun em:eval-control-file (sfa)
 (do ((char (tyi sfa -1)
	    (tyi sfa -1)))
     ((= char -1) t)
     (caseq char
	((#o302 #o342)
	 (break ↑B t))
	((#o307 #o347)
	 (*throw 'em:toplevel t))
	)))

(defun em:initiate-conversation (jobn)
       (em:send-simple-message 'initiate jobn)
       (let ((answer (em:wait-mail)))
	(caseq answer
	       (ok t)
	       (t ()))))

(setq -em:sfa- ())

(defun init (n)
 (setq -em:sfa- (sfa-create 'em:mail-sfa 0 'mail-sfa))
 (em:send-simple-message 'initiate n)
 (em:wait-mail) (em:get-mail))

(setq breakp ())

(defun em:hold-it ()
 (em:send-simple-message 'hold-it -em:jobnum-)
 'hold-it-right-there!!!)

(defun em:e-commands (l sfa)
 (let ((-em:e-commands- t))
	(print l sfa)
	(sfa-call sfa 'force-output ())))

(defun em:wrong-jobnum ()
 (break |Wrong job number| t))
;;; Here are the interrupt handlers for user interrupts

(declare (special $P))
(setq $p (symeval (implode `(,(ascii 125.),(ascii 80.)))))

(defun em:interrupt-handler (message argp arg)
 (setq -em:errorp- t)
 (em:clear-input)
 (terpri -em:sfa-)
 (princ '|;BKPT | -em:sfa-)
 (and argp (progn (princ arg -em:sfa-)
		  (princ '| | -em:sfa-)))
 (princ message -em:sfa-)
 (terpri -em:sfa-)
 (sfa-call -em:sfa- 'force-output ())
 (*catch 'em:out-of-break
	 (do ((message-type (progn (em:wait-mail)
				   (prog2 () (em:get-mail)))
			    (progn (em:wait-mail)
				   (prog2 () (em:get-mail)))))
	     (())
	     (*catch 'em:breaklevel
		     (caseq message-type
			    (sexps
			     (let ((eof (ncons ())))
				  (do ((form (read -em:sfa- eof)
					     (read -em:sfa- eof))
				       (ans))
				      ((cond ((eq form $p))
					     ((eq form '↑G)
					      (print 'QUIT -em:sfa-)
					      (sfa-call -em:sfa- 
							'force-output ())
					      (em:clear-input)
					      (*throw 'em:toplevel t))
					     ((and (listp form) (eq (car form) 'return))
					      (em:clear-input)
					      (*throw 'em:out-of-break
						      (eval (cadr form))))
					     ((eq form eof)
					      t)))
				      (em:eval-protect)
				      (setq ans (errset (eval form)))
				      (em:eval-unprotect)
				      (cond (ans (print (car ans) -em:sfa-)
						 (sfa-call -em:sfa- 'force-output ()))
					    (t (print 'error -em:sfa-)
					       (sfa-call -em:sfa- 'force-print ()))))))
			    (control-chars
			     (em:eval-control-file -em:sfa-))
			    (no-op ())
			    (wrong-job (em:wrong-jobnum)))))))


(defmacro interrupt-handler (var args form)
 (let ((name (implode (append '(e m :)(explode var) '(- h a n d l e r)))))
      `(progn 'compile
	      (setq ,var ',name)
	      (defun ,name ,args ,form))))

(interrupt-handler ↑B () 
		   (em:interrupt-handler '|↑B| () ()))

(interrupt-handler undf-fnctn (fn) 
		   (em:interrupt-handler '|Undefined function| t (car fn)))

(interrupt-handler unbnd-vrbl (vr) 
		   (em:interrupt-handler '|Unbound variable| t (car vr)))

(interrupt-handler wrng-type-arg (arg) 
		   (em:interrupt-handler '|Wrong type arg| t arg))

(interrupt-handler unseen-go-tag (arg) 
		   (em:interrupt-handler '|Unseen tag| t arg))

(interrupt-handler wrng-no-args (arg) 
		   (em:interrupt-handler '|Wrong number of args| t arg))

(interrupt-handler gc-lossage (arg) 
		   (em:interrupt-handler '|GC Lossage| t arg))

(interrupt-handler fail-act (arg) 
		   (em:interrupt-handler '|FAIL-ACT| t arg))

(interrupt-handler pdl-overflow (arg) 
		   (em:interrupt-handler '|PDL overflow| t arg))

(interrupt-handler gc-overflow (arg) 
		   (em:interrupt-handler '|GC overflow| t arg))

(interrupt-handler *rset-trap () 
		   (em:interrupt-handler '|*RSET trap| () ()))

;;; αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
;;; αnαxSLISP talks to job n(10.)
;;; α0αxSLISP types the wholine of inferior
;;; α-αxSLISP murder (i.e. negotiated suicide)
;;; α=	send arrow line or attach buffer
;;; α+nα=	send next n lines
;;; α-nα=	send previous n lines
;;; αx= <sexp>
;;; 	send comand line
;;; 
;;; Protocols: (* means not actually anticipated to be used; current
;;; implementation knows about it but does not send and/or interpret them
;;; specially)
;;; 
;;; From E to MacLisp
;;; 	Mail
;;; 	wd0:	Job# sending message
;;; 	wd1:	type of message
;;; 
;;; 2,,0:   Continuation needed
;;; 1,,0:	Short (fits in the next =30 words, ends with null byte
;;;         or falls off)
;;; 
;;; 0		no-op
;;; 1		initiating a conversation
;;; 2		ok (did the jobread)
;;; 3		SEXPs
;;; 4		explicit eof
;;; 5		control (meta) chars to follow (E macro format)
;;; 		 (or E commands (from MacLisp to E))
;;; 6		interrupt. do <esc>i <char>
;;; 7		close connection (suicide)
;;; 
;;; 	wd2:	-number of bytes,,address of buffer
;;; 		
;;; 
;;; E commands will be represented in the standard E macro manner
;;; (unless there is something better).
;;; 
;;; 
;;; Protocol is:
;;; 	E	MacLisp
;;;         ---------------
;;; 	initiate
;;; 		ok
;;; 
;;; To send a short message just a MAIL
;;; To send a long message MAIL then wait for JOBREAD acknowledge
;;; To send interrupts, just send them
;;; Acknowledgment is the short OK message
;;; 
;;; Commands needed:
;;; 	start DMP file
;;; 	send control chars
;;; 	send interrupt character (just 1 at a time)
;;; 
(lap em:get-mail subr)
(args em:get-mail (nil . 0))

	(defsym noop-type 0)
	(defsym initiate-type 1)
	(defsym ok-type 2)
	(defsym sexp-type 3)
	(defsym explicit-eof-type 4)
	(defsym ecommand-type 5)
	(defsym control-type 5)
	(defsym interrupt-type 6)
	(defsym kill-type 7)
	(defsym high-command 7)

	(defsym alpha 2)
	(defsym beta 3)
	(defsym cont-bit 2)
	(defsym short-bit 1)
	(defsym meta-mask 400)
	(defsym control-mask 200)

em:get-mail
	(skipl 0 mailinp)		;-1 means mail in and not read
	(mail 2 mailbox)		;SRCV
	(jfcl)
	(setzm 0 mailinp)
	(setzm 0 tyi-inited)
	(movei b 'nil)
	(movem b (special sail-mail-interrupt))
	(move tt mailbox)		;get the jobnum
	(skipg 0 jobnum)
	(jrst 0 gm1)
	(came tt jobnum)		;correct one?
	(jrst 0 wrongj)
   	(movem tt jobread)
gm1	(movem tt jobnum)
	(movem tt jobn2)
	(jsp t fxcons)			;number cons
	(movem a (special -em:jobnum-)) ;save it
   	(move tt (+ mailbox 1))		;type bits
	(jrst 0 em:mail-type)

true	(movei a 't)
	(popj p)
false	(movei a 'nil)
	(popj p)

(entry em:get-jobnum subr)
(args em:get-jobnum (nil . 0))
	(move tt (special v.mailint))
	(jsp t fxcons)			;find that entry!
	(movem a (special -em:jobnum-))
	(popj p)

(entry em:set-jobnum subr)
(args em:set-jobnum (nil . 1))
	(move tt 0 a)
	(movem a (special -em:jobnum-))
	(movem tt jobnum)
	(popj p)
wrongj 	(movei a 'wrong-jobnum)
	(popj p)
(entry em:mail-type subr)
(args em:mail-type (nil . 0))

em:mail-type
	(setzm 0 explicit-eof)	;0 means nil
	(setzm 0 forcedp)
	(movei b 'nil)
	(movem b (special -em:control-chars-))
	(move tt (+ mailbox 1));type bits
	(movei a 'nil)		;short flag
	(tlne tt short-bit)
	(movei a 't)
	(movem a (special -em:shortp-))
	(movei a 'nil)
	(tlne tt cont-bit)
	(movei a 't)
	(movem a (special -em-contp-))
	(hrrzs 0 tt)		;grumble, test for range
	(skipge 0 tt)		;too low?
	 (jrst 0 unknown)	;yup, unknown
	(caile tt high-command) ;too high
	 (jrst 0 unknown)
	(xct 0 type-disp tt)	;dispatch
unknown (movei a 'unknown)
	(popj p)
type-disp
	(jrst 0 no-op)
	(jrst 0 initiate)
	(jrst 0 ok)
	(jrst 0 sexps)
	(jrst 0 explicit-eof)
	(jrst 0 cntrl)
	(jrst 0 interrupt)
	(jrst 0 kill)
no-op
	(movei a 'no-op)
	(popj p)
sexps	
	(setzm 0 eofp)		;within eof
	(skipe 0 inbytes)
	(jrst 0 snot-finished)
sresume	(move a (+ mailbox 2))	;get number of bytes
	(move tt (+ mailbox 1));type bits
	(setzm 0 tyi-inited)	;tyi not inited
	(hlrem a inbytes)	;store it
	(hlre b a)		;-number of bytes
	(idivi b 5)		;-number of words
	(jumpe c ztesch)
	(subi b 1)		;one more, bunkie
ztesch	
	(movem b inwords)
	(setom 0 mailprocessed)
	(tlne tt short-bit)	;short?
	(jrst 0 tshort)
	(pushj p transfer-buffer)
	(movei a 'sexps)
	(popj p)
tshort	(pushj p transfer-short)
	(movei a 'sexps)
	(popj p)
cntrl   
	(setzm 0 eofp)		;within eof
	(movei b 't)
	(movem b (special -em:control-chars-))
	(skipe 0 inbytes)
	(jrst 0 cnot-finished)
cresume (setzm 0 tyi-inited)	;tyi not inited
	(move tt (+ mailbox 1));type bits
	(move a (+ mailbox 2))	;get number of bytes
	(hlrem a inbytes)	;store it
	(setom 0 mailprocessed)
	(tlne tt short-bit)	;short?
	(jrst 0 tcshort)
	(pushj p transfer-buffer)
	(movei a 'control-chars)
	(popj p)
tcshort	(pushj p transfer-short)
	(movei a 'control-chars)
	(popj p)
initiate(movei a 'initiate)
	(setom 0 mailprocessed)
	(popj p)
interrupt
	(movei a 'interrupt)
	(setzm 0 mailprocessed)
	(popj p)
explicit-eof
	(setom 0 explicit-eof)
	(movei a 'eof)
	(popj p)
ok
	(movei a 'ok)
	(setzm 0 mailprocessed)
	(popj p)

kill	(pushj p send-ok)
	(calli 1 12)	;kill self

(entry snot subr)
snot-finished
	(setzm 0 tyi-inited)
	(movei a sresume)
	(movem a resume-pc)
	(movei a 'sexps)
	(popj p)

(entry cnot subr)
cnot-finished
	(setzm 0 tyi-inited)
	(movei a cresume)
	(movem a resume-pc)
	(movei a 'control-chars)
	(popj p)
(entry em:wait-mail subr)
(args em:wait-mail (nil . 0))

em:wait-mail
	(722←33 0 mailint)	;imskcl
	(mail 1 mailbox)	;WRCV
	(721←33 0 mailint)	;imskst
	(setom 0 mailprocessed)	;mail now in
	(setom 0 mailinp)	;got mail
      	(movei a 't)
	(popj p)

(entry em:mask-off subr)
(args em:mask-off (nil . 0))
	(722←33 0 mailint)	;imskcl
	(movei a 't)
	(popj p)

(entry em:mask-on subr)
(args em:mask-on (nil . 0))
	(721←33 0 mailint)	;imskst
	(movei a 't)
	(popj p)
(entry em:mail-sfa subr)
(args em:mail-sfa (nil . 3))
	(movei a 0 b)	;operation type ignore the object
	(caie a 'which-operations)
	(jrst 0 t1)
	(movei a '(tyi tyo force-output untyi))
	(popj p)
t1	(cain a 'tyi)		;tyi?
	(jrst 0 em:mail-tyi)
	(cain a 'tyo)		;tyo?
	(jrst 0 em:mail-tyo)
	(cain a 'force-output)	;force output?
	(jrst 0 em:mail-force-output)
	(cain a 'untyi)		;untyi?
	(jrst 0 em:mail-untyi)
	(movei a 'nil)
	(popj p)

;;; TYI

(entry em:mail-tyi)
em:mail-tyi
	(skipe 0 explicit-eof)
	(jrst 0 eeof)
	(movem c eofchar)
	(skipe a (special -em:control-chars-))
	(jrst 0 read-control-chars)
	(skipe 0 untyif)
	(jrst 0 untyi2)
	(skipn 0 tyi-inited)	;not inited?
	(pushj p real-mail-refresh)
	(skipn 0 inbytes)	;and nothing left?
    	(pushj p mail-refresh)
tyi1	(aosle 0 inbytes)
	(pushj p mail-refresh)
inmailok
	(ildb tt inpoint)	;get byte
	(skipl 0 tt)		;- means end of file
	(jrst 0 fix1)		;what a bum!
	(pushj p mail-refresh)
	(jrst 0 tyi1)

em:mail-untyi
	(aos 0 untyif)
	(move b untyipdl)
	(push b c)
	(movem b untyipdl)
	(popj p)

untyi2	(move b untyipdl)
	(sosl 0 untyif)
	(pop b a)
	(movem b untyipdl)
	(popj p)
	
eeof	(setzm 0 explicit-eof)

reof
	(setom 0 eofp)
	(move a eofchar)
	(sub p (% 0 0 1 1))
	(popj p)
;;; TYO

em:mail-tyo
	(setzm 0 forcedp)
	(move a @ c)
	(idpb a outpoint)	;put it there
	(sosg 0 outbytes)	;ready to send?
	(pushj p cmail-sendit)
	(cain a #o12)
	(pushj p fmail-sendit)
	(movei a 't)
	(popj p)

;;; FORCE OUTPUT

fmail-sendit
	(setom 0 forcedp)
cmail-sendit
	(movei tt cont-bit)
	(jrst 0 mail-sendit)

em:mail-force-output
(entry em:mail-force-output subr)
	(skipe 0 forcedp)
	(jrst 0 true)
	(setz tt)		;continuation
mail-sendit
	(movei a 40)		;space
	(idpb a outpoint)
	(sos 0 outbytes)	;extra byte
	(movei a outmail)	;address of buffer
	(movem a (+ mailbox 2))
	(move a outbytes)	
	(movei a #o5000)
	(sub a outbytes)	
	(movei t 1)		;1 in t means long
	(caile a 145.)		;short enough
	(jrst 0 send-message)	;nope
	(setz t)		;0 in T means short
	(hrlzi tt outmail)
	(hrri  tt (+ mailbox 3))
	(blt tt (+ mailbox 32.))	;move to the right place
	(iori tt short-bit)
send-message
	(hrls 0 tt)		;swap
	(hrri tt sexp-type)
	(skipe 0 (special -em:e-commands-))
	(hrri tt ecommand-type)
	(movem tt (+ mailbox 1))
	(movns 0 a)
	(hrlzm a (+ mailbox 2))
	(movei a outmail)
	(hrrm a (+ mailbox 2))
	(move a thisjob)
	(movem a mailbox)
	(pushj p wait-for-clear)
	(mail 0 jobnum)		;mail it
	(jrst 0 false)
	(hrlzi a outmail)
	(hrri a (+ outmail 1))
	(setzm 0 outmail)
	(blt a (+ outmail #o1000))	;zero it
	(hrlzi a mailbox)
	(hrri a (+ mailbox 1))
	(setzm 0 mailbox)
	(blt a (+ mailbox 32.))	;zero it
	(move a outpointtem)	;setup output byte count
	(movem a outpoint)
	(movei a #o5001))
	(movem a outbytes)
	(jumpe t true)		;don't hang around
	(pushj p wait-ok)	;wait for acknowledgment
	(pushj p em:mail-type)
	(came a 'ok)
	(jrst 0 false)
	(jrst 0 true)

(entry rcc subr)
read-control-chars
	(skipn 0 tyi-inited)	;tyi inited?
	(pushj p real-mail-refresh)
	(skipn 0 inbytes)
    	(pushj p mail-refresh)
	(pushj p rgetchar)
	(cain t alpha)
	(movei tt control-mask)	;saw an α
	(jrst 0 read-meta)	;now maybe a β?
	(cain t beta)		;saw a β, so now the char
	(iori t meta-mask)
read-char
	(pushj p rgetchar)
	(ior tt t)
	(jrst 0 fix1)

read-meta
	(pushj p rgetchar)
	(cain t beta)
	(iori t meta-mask)
	(jrst 0 (+ read-char 1))


rgetchar(skipe 0 untyif)
	(jrst 0 runty2)
	(aosle 0 inbytes)
	(pushj p mail-refresh)
	(ildb t inpoint)
	(skipe 0 t)
	(cain t 40)		;space?
	(jrst 0 rgetchar)	;foo, go around
	(popj p)
rceof	(move a eofchar)
	(sub p (% 0 0 1 1))
	(popj p)

runty2	(move b untyipdl)
	(sosl 0 untyif)
	(pop b a)
	(movem b untyipdl)
	(popj p)

;;; This routine gets fresh mail to initialize the reader
mail-refresh
	(skipn 0 (special -em:contp-))	;continuation?
	(skipn 0 eofp)
	(jrst 0 reof)
real-mail-refresh
	(skipn 0 mailprocessed)	;processed?
	(jrst 0 mr1)		;get the next batch
mr3	(pushj p em:wait-mail)	;wait for response
	(jrst 0 em:get-mail)	;get the mail

mr1	(skipn 0 resume-pc)	;ready for crock?
	(jrst 0 mr3)		;nope
    	(pushj p @ resume-pc)	;get the rest
	(popj p)		;continue
;;; This routine does a jobread into the right spot.

transfer-buffer
	(move a inpointtem)	;byte pointer template
	(movem a inpoint)
	(setom 0 tyi-inited)	;ready to read
	(movei tt jobread)
	(pushj p zinmail)
	(move a (+ mailbox 2))
	(hrl a inwords)
	(movem a (+ jobread 1))
	(calli tt 400050)	;jobrd
	(jrst 0 false)
	(jrst 0 send-ok)
	(popj p)		;good return

zinmail
	(hrlzi a inmail)
	(hrri a (+ inmail 1))
	(setzm 0 inmail)
	(blt a (+ inmail #o1000))
	(popj p)

(entry em:clear-input subr)
(args em:clear-input (nil . 0))
	(setzm 0 forcedp)
	(setzm 0 untyif)
	(setzm 0 inbytes)
	(move a temuntyipdl)
	(movem a untyipdl)
	(setom 0 explicit-eof)
	(setom 0 eofp)
	(setzm 0 mailinp)
	(setom 0 mailprocessed)
	(setzm 0 tyi-inited)
	(pushj p zinmail)
	(movei a 't)
	(popj p)
wait-ok  
	(722←33 0 mailint)	;imskcl
	(mail 1 mailbox)	;WRCV
	(721←33 0 mailint)	;imskst
	(move tt (+ mailbox 2))
	(setzm 0 mailinp)
	(hrrzs tt)		;flush short?
	(caie tt ok-type)
	(jrst 0 true)
	(jrst 0 false)
(entry em:send-simple-message subr)
(args em:send-simple-message (nil . 2))

	(cain a 'initiate)
	(jrst 0 initiate-message)
	(cain a 'ok)
	(jrst 0 ok-message)
	(cain a 'hold-it)
	(jrst 0 hold-it-message)
	(cain a 'eof)
	(jrst 0 eof-message)
	(movei a 'Invalid-message)
	(popj p)

eof-message
	(movei a explicit-eof-type)
	(jrst 0 send-simple-message)
initiate-message
	(movei a initiate-type)
	(jrst 0 send-simple-message)
ok-message
	(movei a ok-type)
	(jrst 0 send-simple-message)
hold-it-message
	(movei a 102)
	(movem a (+ mailb2 2))
	(movei a interrupt-type)

send-simple-message
	(movem a (+ mailb2 1))
	(move b 0 b)
	(movem b jobn2)
	(movem b jobnum)
	(move b thisjob)
	(movem b mailb2)
	(movem b mailbox)
	(pushj p wait-for-clear)
     	(mail 0 jobn2)
	(jrst 0 false)
	(jrst 0 true)

wait-for-clear
	(mail 4 jobnum)
	(popj p)
	(setz tt)
	(calli tt 31)
	(jrst 0 wait-for-clear)

(entry em:send-control-char subr)
(args em:send-control-char (nil . 2))

send-control-char
	(movei t -1)		;count
	(move tt outchartem)
	(move a 0 a)		;get character
	(trze a 200)		;control bit
	(pushj p c1)		;push control
	(trze a 400)		;meta bit
	(pushj p m1)		;push meta
	(idpb a tt)
	(movei a control-type)
	(hrli a short-bit)	;short control chars
	(movem a (+ mailb2 1))
	(hrlzm t (+ mailb2 2))
	(movei a outmail)
	(hrrm a (+ mailb2 2))

	(move b 0 b)
	(movem b jobn2)
	(movem b jobnum)
	(move b thisjob)
	(movem b mailb2)
	(movem b mailbox)
	(pushj p wait-for-clear)
     	(mail 0 jobn2)
	(jrst 0 false)
	(jrst 0 true)

c1	(movei r 2)		;alpha
	(idpb r tt)		;send it
	(sos 0 t)		;decrement
	(popj p)

m1	(movei r 3)		;beta
	(idpb r tt)		;send it
	(sos 0 t)		;decrement
	(popj p)
(entry em:initialize subr)
(args em:initialize (nil . 0))

	(setzm 0 mailinp)
	(setom 0 jobnum)
	(calli tt 30)
	(movem tt thisjob)
	(jrst 0 fix1)

transfer-short

	(move a inpointtem)	;byte pointer template
	(movem a inpoint)
	(pushj p zinmail)
	(hrlzi a (+ mailbox 3))	;move from here
	(hrri a inmail)		;to here
	(blt a (+ inmail 30.))	;transfer 30
	(setom 0 tyi-inited)	;ready to read
	(popj p)

send-ok
	(movei a ok-type)
	(movem a (+ mailb2 1))
	(move b thisjob)
	(movem b mailb2)
	(pushj p wait-for-clear)
     	(mail 0 jobn2)
	(jrst 0 false)
	(jrst 0 true)
(entry em:eval-protect subr)
(args em:eval-protect (nil . 0))
(movei a mailbox)
(movem a (special sail-mail-address))
(movei a 't)
(popj p)

(entry em:eval-unprotect subr)
(args em:eval-unprotect (nil . 0))
(movei a 'nil)
(movem a (special sail-mail-address))
(popj p)
;;; Storage for Mail routines

forcedp (0)		;output already forced
inwords (0)		;number of words to input via jobread
explicit-eof (-1)	;nil
eofp (-1)		;-1 means mail in and not read
mailinp (0)		;-1 means mail in and not read
mailint (4000000000)
jobnum	(0)
	(0 0 mailbox)
(entry mailbox subr)
mailbox	(block 32.)	;mail
jobn2 (0)
	(0 0 mailb2)
(entry mailb2 subr)
mailb2(block 32.)	;short mail
(entry inmail subr)
inmail	(block 1000)	;text
(entry outmail subr)
outmail	(block 1000)	;text
stack (block 20)
untyipdl (777760←22 0 stack)
temuntyipdl (777760←22 0 stack)
untyif (0)
(entry inpoint subr)
inpoint (700←22 0 (- inmail 1))
inpointtem (700←22 0 (- inmail 1))
inbytes (0)
outpoint (700←22 0 (- outmail 1))
outpointtem (700←22 0 (- outmail 1))
outchartem (700←22 0 (+ mailb2 2))
outbytes (5001)
control-chars (0)
mailprocessed (-1)	;0 means not processed
tyi-inited (0)		;ready to read. 0 = nil, -1 = t
resume-pc  (0)		;where to get more chars
eofchar (0)		;eof char
thisjob (0)
jobread	(0)
	(0)
	(0 0 inmail)
()

(em:initialize)